home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / PASCAL / 1093.ZIP / MUSIC.ARC / MUSIC.PAS < prev    next >
Pascal/Delphi Source File  |  1988-01-03  |  11KB  |  291 lines
  1. unit Music;
  2.  
  3. {
  4.    MUSIC.PAS allows you play music on IBM PC or compatible using the same
  5.    set of commands that you would use with BASICA's "PLAY" command.
  6.  
  7.    The original module was written and uploaded by Gregory Arakelian
  8.    (74017,223)  703-435-7137.   The code was unitized for Turbo Pascal
  9.    4.0 by Ted Lassagne (70325,206).  Code was added to handle dotted
  10.    notes.  Some error checking was added, and minor corrections and
  11.    optimizations were made.
  12. }
  13.  
  14. {=======================================================================}
  15.  
  16. interface
  17.  
  18. uses CRT;
  19.  
  20. Procedure Play (TuneString:string);
  21.  
  22.   {Play interprets a string very similar to that used with the PLAY
  23.    verb in BASICA.  The two major exceptions are that the "N" order
  24.    is not interpreted and that variables cannot appear in the string.
  25.  
  26.    The string characters are interpreted as follows:
  27.  
  28.       A .. G    The musical notes A thru G.  A note may be followed
  29.                 by an accidental ('#' or '+' for sharp and '-' for
  30.                 flat.)  Additionally, a note (With optional sharp or
  31.                 flat) may also be followed by a number denoting the
  32.                 note length (1 for a whole note thru 64 for a 64th
  33.                 note.)   The note, with optional accidental and
  34.                 length, may also be followed by one or more dots
  35.                 ("."), each of which extends the note by one half
  36.                 of its existing value.  For example, two dots produce
  37.                 a length of 9/4 the original value, and three dots
  38.                 a length of 27/8 the original value.
  39.  
  40.       Ln        Specifies the default length of the notes following
  41.                 ("n" must be 1 for a whole note thru 64 for a 64th
  42.                 note.)  The initial default value is 4 (quarter note.)
  43.  
  44.       Mz        Specifies the fraction of the note length that the
  45.                 note is actually sounding.  "z" is one of the letters
  46.                 "S", "N", or "L", which have these meanings:
  47.  
  48.                    MS   Music staccato   (3/4 of note length)
  49.                    MN   Music normal     (7/8 of note length)
  50.                    ML   Music legato     (all of note length)
  51.  
  52.       On        Specifies the octave in which the notes following
  53.                 are to be played (0 thru 7).  The initial default
  54.                 octave is 3, which is the octave which begins at
  55.                 middle C.
  56.  
  57.       Pn        Specifies that no sound is to be made for an
  58.                 interval.  "n" (optional) is the note length (1
  59.                 for a whole note thru 64 for a 64th note.)  If "n"
  60.                 is omitted, the current default note length is used.
  61.                 One or more dots may follow, each of which extends
  62.                 the rest by one half of its existing value.
  63.  
  64.       Tn        Specifies the tempo in beats per minute (32 thru
  65.                 255.)  The initial default value is 120.
  66.  
  67.       Note: The playing may be interrupted at any time by pressing
  68.       Control-Break or Control-C.  This terminates the program and
  69.       returns control to the operating system.  If you want to
  70.       change this, the keyboard checking code immediately follows
  71.       the note playing code.
  72.  
  73. }
  74.  
  75. {=======================================================================}
  76.  
  77. implementation
  78.  
  79.  
  80. Const
  81.     SharpOffset = 60;
  82.  
  83. Var
  84.     PitchArray : Array[1..120] Of Integer;
  85.       {The first 56 entries in PitchArray are frequencies for
  86.        the notes A..G in seven octaves.  Entries 60 thru 115
  87.        are frequencies for the sharps of the notes in the
  88.        first 56 entries.}
  89.     BaseOctave : Integer;
  90.     Octave     : Integer;
  91.     GenNoteType: Integer;
  92.     Tempo      : Integer;
  93.     PlayFrac   : Byte;
  94.  
  95.  
  96. {PlayInit sets default values for octave, note length, tempo, and
  97.  note length modifier.  It sets up the array of frequencies for the
  98.  notes.}
  99.  
  100. Procedure PlayInit;
  101.   Const
  102.       NextFreq    = 1.05946309436;
  103.   Var
  104.       RealFreq : Array[1..7] Of Real;
  105.       BaseFreq : Real;
  106.       J,K      : Integer;
  107.   Begin
  108.  
  109.    {Set up default values}
  110.  
  111.     BaseOctave := 0;
  112.     Octave := 3;         {Third octave - starts with middle C}
  113.     GenNoteType := 4;    {Quarter note}
  114.     Tempo := 120;        {120 beats per minute}
  115.     PlayFrac := 7;       {Normal - note plays for 7/8 of time}
  116.  
  117.     {Set up frequency array}
  118.  
  119.     BaseFreq := 27.5;    {"A" four octaves below A-440}
  120.     For J := 0 To 7 Do
  121.       Begin
  122.         RealFreq[1] := BaseFreq;
  123.         RealFreq[2] := RealFreq[1]*NextFreq*NextFreq;
  124.         RealFreq[3] := RealFreq[2]*NextFreq;
  125.         RealFreq[4] := RealFreq[3]*NextFreq*NextFreq;
  126.         RealFreq[5] := RealFreq[4]*NextFreq*NextFreq;
  127.         RealFreq[6] := RealFreq[5]*NextFreq;
  128.         RealFreq[7] := RealFreq[6]*NextFreq*NextFreq;
  129.         BaseFreq := BaseFreq * 2;   {next octave}
  130.         For K := 1 to 7 Do
  131.           Begin
  132.             PitchArray[J*7+K] := Round(RealFreq[K]);
  133.             PitchArray[J*7+K+SharpOffset] := Round(RealFreq[K]*NextFreq);
  134.           End;
  135.       End;
  136.   End;
  137.  
  138.  
  139. {Play interprets the passed string and plays the specified notes for
  140.  the specified time periods.   The orders in the string are interpreted
  141.  as outlined in the interface section above.}
  142.  
  143. Procedure Play (TuneString:string);
  144.   Var PlayTime,IdleTime,DotTime,NoteTime  : Integer;
  145.       NoteType,PitchIndex,Position,Number : Integer;
  146.       Code,TuneStrLen                     : Integer;
  147.       Character                           : Char;
  148.  
  149.   Procedure NVal(Pos:integer; var v, code: integer);
  150.   {Extracts a numeric value "v" from the tune string starting at
  151.    the index Pos.  The returned value in "code" is the number of
  152.    digits scanned plus one.}
  153.      var  posn:integer;
  154.      begin
  155.         v := 0;
  156.         posn := Pos;
  157.         while (posn <= TuneStrLen) and
  158.         (TuneString[posn] in ['0'..'9']) do begin
  159.            v := v*10 + ord(TuneString[posn]) - ord ('0');
  160.            posn := posn + 1;
  161.         end;
  162.         code := posn - Pos + 1;
  163.      end {NVal};
  164.  
  165.   Procedure CheckDots;
  166.   {Checks for dots after note or pause.  Each dot increases note
  167.    or rest length by half.}
  168.     begin
  169.        while (Position <= TuneStrLen) and
  170.        (TuneString[Position] = '.') do begin
  171.           DotTime := DotTime + DotTime div 2;
  172.           inc(Position)
  173.        end;
  174.     end {CheckDots};
  175.  
  176.   Begin {Play subroutine}
  177.     CheckBreak := false;
  178.     TuneStrLen := length(TuneString);
  179.     Position := 1;
  180.  
  181.     Repeat
  182.       NoteType := GenNoteType;
  183.       DotTime := 1000;
  184.  
  185.       Character := upcase(TuneString[Position]);
  186.       Case Character Of
  187.         'A'..'G' : Begin
  188.                      PitchIndex := (ord(Character)-64)+Octave*7;
  189.                      If (Character='A') or (Character='B') Then
  190.                        PitchIndex := PitchIndex + 7;  {next octave}
  191.                      inc(Position);
  192.  
  193.                      {Check for sharp or flat}
  194.                      if Position <= TuneStrLen then
  195.                         case TuneString[Position] of
  196.                           '#','+': begin
  197.                             PitchIndex := PitchIndex+SharpOffset;
  198.                             inc(Position);
  199.                            end;
  200.                           '-': begin
  201.                             PitchIndex := PitchIndex+SharpOffset - 1;
  202.                             inc(Position);
  203.                            end;
  204.                         End;
  205.  
  206.                      {Check for length following note}
  207.                      if (Position <= TuneStrLen) and
  208.                      (TuneString[Position] in ['0'..'9']) then begin
  209.                         NVal(Position,NoteType,Code);
  210.                         inc(Position, Code - 1)
  211.                      end;
  212.  
  213.                      {Check for dots after note}
  214.                      CheckDots;
  215.  
  216.                      {Play the note}
  217.                      NoteTime := Round(DotTime/Tempo/NoteType*240);
  218.                      PlayTime := Round(NoteTime*PlayFrac/8);
  219.                      IdleTime := NoteTime-PlayTime;
  220.                      Sound(PitchArray[PitchIndex]);
  221.                      Delay(PlayTime);
  222.                      if IdleTime <> 0 then begin
  223.                         NoSound;
  224.                         Delay(IdleTime)
  225.                      end;
  226.  
  227.                      {Check for Ctl-Break pressed}
  228.                      if keypressed and (ReadKey = ^C) then begin
  229.                         NoSound;
  230.                         halt
  231.                      end;
  232.  
  233.                    End;
  234.              'L' :  {Note length (1 thru 64).  "1" signifies a
  235.                      whole note and "64" a 64th note.}
  236.                    Begin
  237.                      NVal (Position+1,GenNoteType,Code);
  238.                      if (GenNoteType < 1) or (GenNoteType > 64) then
  239.                         GenNoteType := 4;
  240.                      inc(Position, Code);
  241.                    End;
  242.              'M' :  {Note length modifier - "S" for staccato,
  243.                      "L" for legato, or "N" for normal.}
  244.                    Begin
  245.                      if Position < TuneStrLen then begin
  246.                         Case upcase(TuneString[Position+1]) Of
  247.                           'S' : PlayFrac := 6;
  248.                           'N' : PlayFrac := 7;
  249.                           'L' : PlayFrac := 8;
  250.                         End;
  251.                         inc(Position, 2);
  252.                      end;
  253.                    End;
  254.              'O' :  {Octave specification (0 thru 7)}
  255.                    Begin
  256.                      NVal (Position+1,Octave,Code);
  257.                      Octave := Octave+BaseOctave;
  258.                      if Octave > 7 then Octave := 3;
  259.                      inc(Position, Code);
  260.                    End;
  261.              'P' :  {Pause (rest) followed by optional value of
  262.                      1 thru 64, with "1" signifying a whole rest
  263.                      and "64" a 64th rest.}
  264.                    Begin
  265.                      NoSound;
  266.                      NVal (Position+1,NoteType,Code);
  267.                      if (NoteType < 1) or (NoteType > 64) then
  268.                         NoteType := GenNoteType;
  269.                      inc(Position, Code);
  270.                      CheckDots;
  271.                      IdleTime := DotTime Div Tempo * (240 Div NoteType);
  272.                      Delay (IdleTime);
  273.                    End;
  274.              'T' :  {Tempo - number of beats per minute (32 - 255)}
  275.                    Begin
  276.                      NVal (Position+1,Tempo,Code);
  277.                      if (Tempo < 32) or (Tempo > 255) then
  278.                         Tempo := 120;
  279.                      inc(Position, Code);
  280.                    End;
  281.             Else inc(Position);   {Ignore spurious characters}
  282.       End;
  283.     Until Position > TuneStrLen;
  284.     NoSound;
  285.   End {Play};
  286.  
  287. Begin    {Initialization}
  288.  
  289.   PlayInit;
  290.  
  291. End.